home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS in a Box 7
/
BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso
/
Files
/
Prog
/
D-G
/
DA Skeleton 2.0.cpt
/
DASkeleton.p
next >
Wrap
Text File
|
1990-06-09
|
14KB
|
496 lines
{ DASkeleton (v2.0) }
{ By: Michael J. Conrad }
{ }
{ This DA skeleton was written in THINK Pascal™ 3.01. }
{ }
{ Intro. }
{ ----- }
{ I wrote DASkeleton to aid new programmers in writing desk accessories. All }
{ you really have to do is add in what you want your DA to do. This skeleton }
{ takes care of almost all the normal things DAs must do. }
{ }
{ DASkeleton is also good for experienced programmers who are tired of typing }
{ in all the basics every time they write a desk accessory. }
{ }
{ DA Shell Users }
{ ------------- }
{ If you use the DA Shell that comes on your THINK Pascal™ disk, there are some }
{ things you must change or take into consideration: }
{ }
{ 1. The formula for figuring the owned resources must be changed. For the }
{ DA Shell, your DA's refNum must be calculated as: }
{ }
{ refNum:=Abs(dce^.dCtlRefNum)-1; }
{ }
{ For the actual desk accessory, it must be calculated as: }
{ }
{ refNum:=Abs(-dce^.dCtlRefNum)-1; }
{ }
{ Note that the way the instructions say to do it in the DA Shell is wrong. }
{ The THINK Pascal™ user's manual explains it correctly. }
{ }
{ 2. When handling mouse down events in the DA Shell, you must have your }
{ DA handle it as "InContent". As a real DA, you must have it as }
{ "inSysWindow". You must physically change the case constants in the }
{ doMouseDown procedure. }
{ }
{ 4. When using the DA Shell, you must create "dummy" procedures for }
{ RememberA4, SetUpA4, and RestoreA4. This is because only the }
{ DRVRRuntime library contains these procedures. }
{ }
{ 3. Read the instructions in the DAShell and the THINK Pascal™ users manual }
{ for more information. }
{ }
{ Version 2.0 Changes }
{ ------------------- }
{ }
{ The changes in 2.0 are really too numerous to mention. But here are a few key }
{ changes. }
{ }
{ √ Code is broken into more separate procedures. }
{ √ Fixed menu bug where it wouldn't go away when DA was closed. }
{ √ Fixed reentrancy problems. }
{ √ Set the dCtlFlags manually now. This kind of goes with the one above. }
{ √ Included a hierarchical menu. }
{ }
{ Where Did All The Comments Go? }
{ ------------------------------ }
{ I didn't add as many comments in version 2.0 as there has been in previous }
{ versions. This is because the comments tended to "get in the way". If you're }
{ writing a DA, you should already be fairly familiar with programming the }
{ Macintosh™, so most of the comments aren't needed anyway. }
{ }
{ Using Hierarchical Menus In DA's }
{ --------------------------- }
{ If you use the DA Shell, be sure you use the revised one. The latest one to date }
{ and the only one which supports hierarchical menus was revised on 5/22/90 by }
{ Dennis King (DLK). It can be found in the Symantec™ forum on CIS. }
{ }
{ Watch Out!! }
{ ----------- }
{ If you use the cdev hierDA (A.K.A. DA Menuz), you must disable it before }
{ attempting to run your DA in the DA Shell. This is because hierDA automatically }
{ opens a DA when it thinks one of its menus is being used. And if one of your }
{ hierarchical menus happens to have the same id as an exhisting DA, the DA will }
{ open suddenly on you, and may cause a system crash (it does on my machine). }
{ }
{ Non-THINK Pascal Users }
{ ---------------------- }
{ You can still use this DA Skeleton, but...most other pascal compilers don't }
{ allow the use of global data in drivers. }
{ }
{ Mentionware }
{ ------------ }
{ If you use this as your skeleton, all I ask for is that either in your about box }
{ or documentation, you mention that you used DASkeleton. }
{ }
{ Credits }
{ ------- }
{ Thanks to Dennis King, who passed along some bugs he noticed and help me out }
{ with the menu and bit setting problems. He is also responsible for revising the }
{ DA Shell to watch for hierarchical menus. }
{ }
{ In Closing }
{ --------- }
{ If you find any bugs _PLEASE_ let me know so I can fix them. I would rather }
{ fix them instead of having someone else spend hours trying to fix one of my }
{ mistakes! }
{ }
{ DASkeleton is Copyright (c) 1989-90, Michael Conrad. All Rights Reserved. }
{ CIS: [73457,426] GENIE: M.CONRAD1 Amer.On: MichaelC50 }
unit DASkeleton;
interface
uses
Globals, MiscRoutines;
{All drivers and code resources in LSP must have a function or procedure called 'main'}
function main (theDce: DCtlPtr; iopb: ParmBlkPtr; sel: integer): OSErr;
implementation
{--------------------------------•--------------------------------}
{Our window just got uncovered, so redraw the window}
procedure UpdateWindow;
const
Line1 = 'DA Skeleton';
Line2 = 'Version 2.0';
Line3 = 'Written in THINK Pascal™ 3.0';
Line4 = 'Copyright (c) 1989-90';
Line5 = 'By: Michael J. Conrad';
begin
SetPort(window);
TextSize(12);
TextFont(geneva);
TextFace([Outline]);
MoveTo(90, 20);
DrawString(Line1);
TextFace([]);
TextFace([italic]);
MoveTo(95, 34);
DrawString(Line2);
TextFace([]);
MoveTo(38, 50);
DrawString(Line3);
MoveTo(5, 60);
LineTo(255, 60);
TextSize(9);
MoveTo(10, 77);
DrawString(Line4);
MoveTo(10, 90);
DrawString(Line5);
DrawControls(window);
end;
{--------------------------------•--------------------------------}
procedure DoButton (theControl: ControlHandle);
var
Part: integer;
err: integer;
thePoint: Point;
begin
Part := TrackControl(theControl, thePoint, nil);
if (Part = InButton) then
begin
err := CloseDriver(dce^.dCtlRefNum);
end;
end;
{--------------------------------•--------------------------------}
procedure doMouseDown (thePoint: Point);
var
thePart: integer;
where: integer;
theControl: ControlHandle;
begin
thePart := FindWindow(thePoint, window);
if (thePart = inContent) then
begin
GlobalToLocal(thePoint);
where := FindControl(thePoint, window, theControl);
if (theControl = theButton) then
DoButton(theControl);
end;
end;
{--------------------------------•--------------------------------}
procedure DoKeyDown (event: EventPtr);
var
ch: char;
begin
ch := Chr(BitAnd(event^.message, CharCodeMask));
if BitAnd(event^.modifiers, CmdKey) <> 0 then
if event^.what <> autoKey then
begin
case ch of {This covers the standard command keys}
'z', 'Z': {in the Edit menu.}
SysBeep(1);
'x', 'X':
SysBeep(1);
'c', 'C':
SysBeep(1);
'v', 'V':
SysBeep(1);
{Insert other command keys here}
end;
end;
end;
{--------------------------------•--------------------------------}
procedure DoActivate (event: EventPtr);
begin
if BitAnd(event^.modifiers, ActiveFlag) <> 0 then
begin
InsertMenu(ourMenu, 0);
InsertMenu(hierMenu, -1);
DrawMenuBar;
end
else
begin
DeleteMenu(dce^.dCtlMenu);
DeleteMenu(hierMID);
DrawMenuBar;
end;
end;
{--------------------------------•--------------------------------}
{This routine handles the events that are passed to us via control}
procedure doEvent (event: EventPtr);
begin
case event^.what of
keyDown:
DoKeyDown(event);
mouseDown:
doMouseDown(event^.where);
UpdateEvt:
begin
SetPort(window);
BeginUpdate(window);
UpdateWindow;
EndUpdate(window);
end;
ActivateEvt:
DoActivate(event);
end;
end;
{--------------------------------•--------------------------------}
{Put up an about window an brag about ourselves}
procedure DoAbout (window: WindowPtr);
var
AboutDlg: DialogPtr;
savePort: GrafPtr;
item: integer;
Flag: Boolean;
begin
GetPort(savePort);
HideWindow(window);
AboutDlg := GetNewDialog(rslvid(ABOUTID), nil, WindowPtr(-1));
CenterWindow(AboutDlg, True, True);
ShowWindow(AboutDlg);
SetPort(AboutDlg);
Flag := True;
while Flag do
begin
ModalDialog(@updateFilter, item);
if (item = 1) then
Flag := False;
end;
DisposDialog(AboutDlg);
ShowWindow(window);
SetPort(savePort);
end;
{--------------------------------•--------------------------------}
procedure InitWindow;
begin
{Get our window from the resource. (a WIND resource)}
window := GetNewWindow(rslvid(MAINWINDOW), nil, WindowPtr(-1));
CenterWindow(window, True, False);
SetWTitle(window, TITLE);
ShowWindow(window);
SetPort(window);
WindowPeek(window)^.windowkind := dce^.dCtlRefNum;
dce^.dCtlWindow := WindowPtr(window);
theButton := GetNewControl(rslvid(BUTTONID), window);
end;
{--------------------------------•--------------------------------}
procedure InitMenus;
var
theID: integer;
begin
theID := rslvid(MENUID);
ourMenu := GetMenu(theID);
ourMenu^^.menuId := theID;
dce^.dCtlMenu := theID;
InsertMenu(ourMenu, 0);
hierMenu := GetMenu(rslvid(HIERID));
hierMenu^^.menuId := hierMID;
InsertMenu(hierMenu, -1);
DrawMenuBar;
end;
{--------------------------------•--------------------------------}
procedure HandleMenus (theMenu, theItem: integer);
begin
if (theMenu = dce^.dCtlMenu) then
case theItem of
1:
DoAbout(window);
2:
SysBeep(10);
3:
SysBeep(10);
4:
SysBeep(10);
otherwise
;
end;
if (theMenu = hierMID) then
case theItem of
1:
SysBeep(1);
2:
;
3:
;
otherwise
;
end;
HiliteMenu(0);
end;
{--------------------------------•--------------------------------}
{//////////// Driver Routines Are Below Here ////////////}
{--------------------------------•--------------------------------}
{This procedure handles our open call. It puts up a window and}
{gets our menu for our DA. In addition it figures the screen size}
{and our drivers reference number.}
procedure open (iopb: ParmBlkPtr);
begin
window := WindowPtr(dce^.dCtlWindow);
if not DAOpen then
begin
DAOpen := True;
screenBounds := GetScrSize; {Get the screen size}
InitWindow;
InitMenus;
end
else
SelectWindow(window);
end;
{--------------------------------•--------------------------------}
{This procedure handles control calls from the dce. Such as}
{menus, and other events.}
procedure control (iopb: ParmBlkPtr);
begin
window := WindowPtr(dce^.dCtlWindow);
SetPort(window);
case iopb^.csCode of
accEvent:
doEvent(Pointer(iopb^.ioMisc));
accRun:
begin
{*** Your DA is getting time from the system...Do whatever ***}
end;
accMenu:
HandleMenus(iopb^.csParam[0], iopb^.csParam[1]);
accUndo:
SysBeep(1);
accCut:
SysBeep(1);
accCopy:
SysBeep(1);
accPaste:
SysBeep(1);
accClear:
SysBeep(1);
end;
end;
{--------------------------------•--------------------------------}
{This routine handles our close call. It takes down our window}
{and clears the menu bar. Always clean up behind yourself!!}
procedure close (iopb: ParmBlkPtr);
begin
window := WindowPtr(dce^.dCtlWindow);
if (DAOpen) then
begin
DeleteMenu(hierMID);
DeleteMenu(dce^.dCtlMenu);
DrawMenuBar;
ReleaseResource(Handle(ourMenu)); {Just for GP}
ReleaseResource(Handle(hierMenu));
dce^.dCtlMenu := 0;
ourMenu := nil;
hierMenu := nil;
DisposeWindow(window);
dce^.dCtlWindow := nil;
DAOpen := False;
end;
end;
{--------------------------------•--------------------------------}
procedure prime (iopb: ParmBlkPtr);
begin
{Only "real" drivers use this call. We don't need it in this DA}
end;
{--------------------------------•--------------------------------}
procedure status (iobp: ParmBlkPtr);
begin
{Only "real" drivers use this call. We don't need it in this DA}
end;
{--------------------------------•--------------------------------}
function main (theDce: DCtlPtr; iopb: ParmBlkPtr; sel: integer): OSErr;
const
drvrOpen = 0;
drvrPrime = 1;
drvrControl = 2;
drvrStatus = 3;
drvrClose = 4;
dCtlEnable = 2; {Enable/Disable control calls}
dNeedTime = 5; {Give us some time from the system}
begin
main := 0; {No problems...}
RememberA4;
BitClr(@theDCE^.dCtlFlags, dCtlEnable);
dce := theDce;
case sel of
drvrOpen:
begin
if (dce^.dCtlStorage = nil) then {For some reason, we could not get enough }
begin {memory to run. Exit the DA. You could put}
SysBeep(5); {a dialog up stating that the DA can't run,but}
main := -108; {you can't use any globals!!}
Exit(main);
end;
open(iopb); {Call OPEN procedure}
end;
drvrPrime:
prime(iopb);
drvrControl:
control(iopb); {Handle a CONTROL call for our DA}
drvrStatus:
status(iopb);
drvrClose:
close(iopb); {Close our DA}
end;
theDce^.dCtlDelay := 60; {Get us some time}
BitSet(@theDCE^.dCtlFlags, dCtlEnable); {Set our flags}
BitSet(@theDCE^.dCtlFlags, dNeedTime);
end;
{--------------------------------•--------------------------------}
end.
